home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SAMPLES / COLLATZ.S < prev    next >
Encoding:
Text File  |  1993-06-13  |  1.1 KB  |  39 lines
  1. (define (dist n)
  2.   (define (compute n)
  3.     (if (<= n 10)
  4.     (vector-ref #(0 1 7 2 5 8 16 3 19 6) (-1+ n))
  5.     (let loop ((bits 3) (pow 8))
  6.       (let ((next (* pow pow)))
  7.         (if (>= next n)
  8.         (let* ((qt (quotient n pow))
  9.                (rt (remainder n pow))
  10.                (u (CollatzMod rt bits)))
  11.           (+ (cdr u) bits
  12.              (compute (+ (car u) (* qt (expt 3 (cdr u)))))))
  13.         (loop (+ bits bits) next))))))
  14.   (if (or (not (integer? n))
  15.       (< n 1))
  16.       (error "Invalid argument" n))
  17.   (compute n))
  18.  
  19. (define (CollatzMod a b)
  20.   (if (<= b 3)
  21.       (vector-ref (vector-ref '#(#((0 . 0) (0 . 0) (0 . 0))
  22.                  #((2 . 1) (1 . 1) (2 . 2))
  23.                  #(() (2 . 1) (1 . 1))
  24.                  #(() (8 . 2) (4 . 2))
  25.                  #(() () (2 . 1))
  26.                  #(() () (2 . 1))
  27.                  #(() () (8 . 2))
  28.                  #(() () (26 . 3))) a) (-1+ b))
  29.       (let* ((b2 (quotient b 2))
  30.          (pow (expt 2 b2))
  31.          (u1 (CollatzMod (remainder a pow) b2))
  32.          (t (+ (* (quotient a pow) (expt 3 (cdr u1)))
  33.            (car u1)))
  34.          (u2 (CollatzMod (remainder t pow) b2)))
  35.     (cons (+ (* (quotient t pow) (expt 3 (cdr u2))) (car u2))
  36.           (+ (cdr u1) (cdr u2))))))
  37.  
  38.  
  39.